home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / os2 / kzr0597.zip / Q_.CMD < prev    next >
OS/2 REXX Batch file  |  1997-02-06  |  4KB  |  101 lines
  1. /*  REXX-Programm q_.cmd  */
  2.  
  3.    Call RxFuncAdd 'SysLoadFuncs', RexxUtil, 'SysLoadFuncs'
  4.    Call SysLoadFuncs
  5.    signal on syntax name q_Msg
  6.  
  7. /* Diese Variablen müssen für jede Prozedur definiert werden, damit die  */
  8. /* Prozedur die Variable bufND kennt und die Variable ND übernehmen kann.*/
  9.    Pfd=SysSearchPath("PATH", "kzr.cmd")
  10.    lp=LastPos("\", Pfd)
  11.    Pfd=DelStr(Pfd, 1+lp)
  12.    NDAq_ =Pfd||"NDAq_.DAT"
  13.    bufND =Pfd||"NDZahl.DAT"
  14.    bufMsg=Pfd||"Meldung.DAT"
  15.    ND = LineIn(bufND, 1)
  16.  
  17.    if ND > 50 then
  18.    do
  19.      ND=50
  20.      call charout(NDAq_) ; Call SysFileDelete NDAq_
  21.      ret=LineOut(NDAq_, 50)
  22.      Call Charout,"   Achtung, nur  50 Dezimalstellen bei der Berechnung von   q_(...)"
  23.      say
  24.      Beep(444, 200); Beep(628,300)
  25.    end
  26.  
  27.    /* Wenn ND <= 50 ist, wird ND = ND  weitergegeben */
  28.    call charout(NDAq_) ; Call SysFileDelete NDAq_
  29.    ret=LineOut(NDAq_, ND)
  30.  
  31.    numeric digits 125
  32.    /*    2/sqrt(2*Pi)=sqrt(2/Pi)  */
  33.    c=0.7978845608028653558798921198687637369517172623298693153318516593413158517986036770025046678146138728606051177252703653710220
  34.    /*    1/sqrt(2*Pi)   */
  35.    d=0.39894228040143267793994605993438186847585863116493465766592582967065792589930183850125233390730693643030255886263518268551099
  36.    Numeric Digits ND+10
  37.  
  38.    arg x,y
  39.    z=x*x  /* Diese Anweisung prvoziert eine Syntax-Fehlermeldung */
  40.  
  41.    if length(y) > 0 then
  42.    do
  43.      call charout(NDAq_) ; Call SysFileDelete NDAq_
  44.      ret=LineOut(bufMsg, "Im Argument von  q_(...)  ist mindestens  1  nicht zulässiges Komma !")
  45.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  46.   /*  damit in den diesbezüglichen temporären Dateien                      */
  47.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  48.      EXIT
  49.    end
  50.  
  51.    if x>=0 then sgn=1; else sgn=-1
  52.    x=abs(x)
  53.  
  54.    if x >=  0    &  x <  6.2 then SIGNAL A
  55.    if x >=  6.2  &  x < 14.8 then SIGNAL B
  56.    if x >= 14.8  then do y=1; SIGNAL C; end
  57.  
  58. A: u=1; v=1; n=1; m=2;
  59.    do while abs(u/v)>10**(-ND-7)
  60.      g=-z*(m-1)/(m*(m+1)); u=u*g;  v=v+u; n=n+1; m=2*n
  61.    end
  62.    y=c*x*v; SIGNAL C
  63.  
  64. B: u=d*exp(-x*x/2)
  65.    /* Der folgende Kettenbruch stammt aus dem Lexikon der Stochastik, */
  66.    /* Seite 289; In der Definition von Φ(x) die Grenzen beachten !    */
  67.    /* Nur bis zu 8 solcher Klammer-Verschachtelungen je Zeile         */
  68.    /* werden erkannt; andernfalls meldet REXX einen Fehler.           */
  69.    v12=96/x
  70.    v11=88/(x+89/(x+90/(x+91/(x+92/(x+93/(x+94/(x+95/(x+v12))))))))
  71.    v10=80/(x+81/(x+82/(x+83/(x+84/(x+85/(x+86/(x+87/(x+v11))))))))
  72.    v9 =72/(x+73/(x+74/(x+75/(x+76/(x+77/(x+78/(x+79/(x+v10))))))))
  73.    v8 =64/(x+65/(x+66/(x+67/(x+68/(x+69/(x+70/(x+71/(x+v9 ))))))))
  74.    v7 =56/(x+57/(x+58/(x+59/(x+60/(x+61/(x+62/(x+63/(x+v8 ))))))))
  75.    v6 =48/(x+49/(x+50/(x+51/(x+52/(x+53/(x+54/(x+55/(x+v7 ))))))))
  76.    v5 =40/(x+41/(x+42/(x+43/(x+44/(x+45/(x+46/(x+47/(x+v6 ))))))))
  77.    v4 =32/(x+33/(x+34/(x+35/(x+36/(x+37/(x+38/(x+39/(x+v5 ))))))))
  78.    v3 =24/(x+25/(x+26/(x+27/(x+28/(x+29/(x+30/(x+31/(x+v4 ))))))))
  79.    v2 =16/(x+17/(x+18/(x+19/(x+20/(x+21/(x+22/(x+23/(x+v3 ))))))))
  80.    v1 = 8/(x+ 9/(x+10/(x+11/(x+12/(x+13/(x+14/(x+15/(x+v2 ))))))))
  81.    v  = 1/(x+ 1/(x+ 2/(x+ 3/(x+ 4/(x+ 5/(x+ 6/(x+ 7/(x+v1 ))))))))
  82.    y  =1-2*v*u
  83.  
  84. C: y=sgn*y     /* Bis hierher ist  y = Φ(x)  */
  85.    u=(1-y)/2   /* u = (1 - Φ(x))/2 = Q(x)    */
  86.    numeric digits ND
  87.    return(Format(u))
  88.  
  89. q_Msg:
  90.    sf=ErrorText(RC)
  91.    if  Pos("Bad arithmetic conversion", sf) > 0 then
  92.    do
  93.      call charout(NDAq_) ; Call SysFileDelete NDAq_
  94.      ret=LineOut(bufMsg, "Sie haben in  q_(...)  kein gültiges Argument eingegeben !")
  95.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  96.   /*  damit in den diesbezüglichen temporären Dateien                      */
  97.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  98.      EXIT
  99.    end
  100.  
  101.